home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / TOOLPAS2 / EASYDJ.PAS < prev    next >
Pascal/Delphi Source File  |  1989-11-13  |  11KB  |  468 lines
  1.  
  2. (*
  3.  * EasyDJ - Convert AS-EASY-AS graphics to DeskJet graphics
  4.  *
  5.  * S.H.Smith, 19-oct-89 (13-nov-89)
  6.  *
  7.  *)
  8.  
  9. {$undef test}
  10.  
  11. {$ifdef test}
  12.    {$r+,s-}
  13. {$else}
  14.    {$r-,s-}
  15. {$endif}
  16.  
  17. {$m 10000,1000,1000}
  18.  
  19. uses dos, mdosio;
  20.  
  21. const
  22.    leadpix = 120;    {left margin in pixels}
  23.  
  24. type
  25.    rastline = array[1..1100] of char;
  26.  
  27.    pt = record
  28.       o,s: word;
  29.    end;
  30.  
  31. var
  32.    image:      array[1..1000] of char;
  33.    imagesz:    integer;
  34.  
  35.    raster:     array[1..34] of rastline;
  36.    rline:      integer;
  37.  
  38.    fd:         dos_handle;
  39.    buffer:     array[1..10240] of char;
  40.    bnext:      integer;
  41.    blast:      integer;
  42.  
  43.  
  44.  
  45. (* -------------------------------------------------------- *)
  46. procedure bread(var dest: char);
  47. begin
  48.    if bnext > blast then
  49.    begin
  50.       blast := dos_read(fd,buffer,sizeof(buffer));
  51.       bnext := 1;
  52.    end;
  53.  
  54.    dest := buffer[bnext];
  55.    inc(bnext);
  56. end;
  57.  
  58.  
  59. (* -------------------------------------------------------- *)
  60. procedure mread(var d; num: integer);
  61. var
  62.    dest: array[1..10000] of char absolute d;
  63.    i:    integer;
  64.  
  65. begin
  66.    if (blast-bnext) >= num then
  67.    begin
  68.       move(buffer[bnext],dest[1],num);
  69.       inc(bnext,num);
  70.    end
  71.    else
  72.  
  73.    for i := 1 to num do
  74.       bread(dest[i]);
  75. end;
  76.  
  77.  
  78. (* -------------------------------------------------------- *)
  79. procedure printc(s: string);  {print characters, 3x faster than dos}
  80. var
  81.    reg:  registers;
  82.    i:    integer;
  83. begin
  84. {$ifndef test}
  85.    for i := 1 to length(s) do
  86.    begin
  87.       reg.ax := ord(s[i]);
  88.       reg.dx := 0;
  89.       intr(23, reg);
  90.    end;
  91. {$endif}
  92. end;
  93.  
  94.  
  95. (* -------------------------------------------------------- *)
  96. function itoa(i: word): string;
  97. var
  98.    s: string;
  99. begin
  100.    str(i,s);
  101.    itoa := s;
  102. end;
  103.  
  104.  
  105. (* -------------------------------------------------------- *)
  106. procedure outpix(bit: byte);
  107. var
  108.    i:    integer;
  109.    b:    integer;
  110.    de:   ^char;
  111. var
  112.    dep:  pt absolute de;
  113.  
  114. begin
  115.    de := @raster[rline][1];
  116.  
  117. Inline(
  118.   $8B/$0E/>IMAGESZ/      {   MOV CX,[>IMAGESZ]}
  119.   $8A/$46/<BIT/          {   MOV AL,[BP+<BIT]}
  120.   $BF/>IMAGE/            {   MOV DI,>IMAGE}
  121.   $C4/$76/<DE/           {   LES SI,[BP+<DE]}
  122.                          {NEXT:}
  123.   $83/$F9/$01/           {   CMP CX,1}
  124.   $7E/$5B/               {   JLE LAST}
  125.   $30/$E4/               {   XOR AH,AH}
  126.   $84/$05/               {   TEST AL,[DI]}
  127.   $75/$2D/               {   JNZ SETBIT0}
  128.                          {BIT1:}
  129.   $47/                   {   INC DI}
  130.   $84/$05/               {   TEST AL,[DI]}
  131.   $75/$2D/               {   JNZ SETBIT1}
  132.                          {BIT2:}
  133.   $47/                   {   INC DI}
  134.   $84/$05/               {   TEST AL,[DI]}
  135.   $75/$2D/               {   JNZ SETBIT2}
  136.                          {BIT3:}
  137.   $47/                   {   INC DI}
  138.   $84/$05/               {   TEST AL,[DI]}
  139.   $75/$2D/               {   JNZ SETBIT3}
  140.                          {BIT4:}
  141.   $47/                   {   INC DI}
  142.   $84/$05/               {   TEST AL,[DI]}
  143.   $75/$2D/               {   JNZ SETBIT4}
  144.                          {BIT5:}
  145.   $47/                   {   INC DI}
  146.   $84/$05/               {   TEST AL,[DI]}
  147.   $75/$2D/               {   JNZ SETBIT5}
  148.                          {BIT6:}
  149.   $47/                   {   INC DI}
  150.   $84/$05/               {   TEST AL,[DI]}
  151.   $75/$2D/               {   JNZ SETBIT6}
  152.                          {BIT7:}
  153.   $47/                   {   INC DI}
  154.   $84/$05/               {   TEST AL,[DI]}
  155.   $75/$2D/               {   JNZ SETBIT7}
  156.                          {BIT8:}
  157.   $47/                   {   INC DI}
  158.   $26/                   {   ES:}
  159.   $88/$24/               {   MOV [SI],AH}
  160.   $46/                   {   INC SI}
  161.   $83/$E9/$08/           {   SUB CX,8}
  162.   $EB/$C8/               {   JMP NEXT}
  163.                          {SETBIT0:}
  164.   $80/$C4/$80/           {   ADD AH,128}
  165.   $EB/$CE/               {   JMP BIT1}
  166.                          {SETBIT1:}
  167.   $80/$C4/$40/           {   ADD AH,64}
  168.   $EB/$CE/               {   JMP BIT2}
  169.                          {SETBIT2:}
  170.   $80/$C4/$20/           {   ADD AH,32}
  171.   $EB/$CE/               {   JMP BIT3}
  172.                          {SETBIT3:}
  173.   $80/$C4/$10/           {   ADD AH,16}
  174.   $EB/$CE/               {   JMP BIT4}
  175.                          {SETBIT4:}
  176.   $80/$C4/$08/           {   ADD AH,8}
  177.   $EB/$CE/               {   JMP BIT5}
  178.                          {SETBIT5:}
  179.   $80/$C4/$04/           {   ADD AH,4}
  180.   $EB/$CE/               {   JMP BIT6}
  181.                          {SETBIT6:}
  182.   $80/$C4/$02/           {   ADD AH,2}
  183.   $EB/$CE/               {   JMP BIT7}
  184.                          {SETBIT7:}
  185.   $80/$C4/$01/           {   ADD AH,1}
  186.   $EB/$CE);              {   JMP BIT8}
  187.                          {LAST:}
  188.  
  189. (********
  190.    i := 1;
  191.    while i < imagesz do
  192.    begin
  193.       b := 0;
  194.       if (ord(image[i  ]) and bit) <> 0 then inc(b,$80);
  195.       if (ord(image[i+1]) and bit) <> 0 then inc(b,$40);
  196.       if (ord(image[i+2]) and bit) <> 0 then inc(b,$20);
  197.       if (ord(image[i+3]) and bit) <> 0 then inc(b,$10);
  198.       if (ord(image[i+4]) and bit) <> 0 then inc(b,$08);
  199.       if (ord(image[i+5]) and bit) <> 0 then inc(b,$04);
  200.       if (ord(image[i+6]) and bit) <> 0 then inc(b,$02);
  201.       if (ord(image[i+7]) and bit) <> 0 then inc(b,$01);
  202.  
  203.       de^ := chr(b);
  204.       inc(dep.o);   {inc(c);}
  205.       inc(i,8);
  206.    end;
  207. *********)
  208. end;
  209.  
  210.  
  211. (* -------------------------------------------------------- *)
  212. procedure convert_bitstream;
  213. var
  214.    c:    char;
  215.    i:    integer;
  216.    b:    integer;
  217.    sz:   word;
  218.  
  219. begin
  220.    {determine size of graph segment}
  221.    mread(sz,2);
  222.    if sz+8{?} > imagesz then
  223.       imagesz := sz+8{?};
  224.  
  225. {writeln('imagesz=',imagesz);}
  226.  
  227.    if imagesz > sizeof(image) then
  228.    begin
  229.       writeln('image too large; imagesz=',imagesz,' allocated=',sizeof(image));
  230.       halt;
  231.    end;
  232.  
  233.    {load the pixel image of the graph segment}
  234.    fillchar(image,sizeof(image),0);
  235.    mread(image[1],sz);
  236.  
  237.    b := $80;
  238.    for i := 1 to 8 do
  239.    begin
  240.       outpix(b);
  241.       b := b shr 1;
  242.       inc(rline);
  243.    end;
  244. end;
  245.  
  246.  
  247. (* -------------------------------------------------------- *)
  248. procedure outrast(rl: integer);
  249. var
  250.    i: integer;
  251.    s: integer;
  252.    n: integer;
  253.    c: char;
  254.    sr: ^char;
  255. var
  256.    srp: pt absolute sr;
  257. const
  258.    skip: integer = 0;
  259.  
  260. begin
  261.    n := imagesz div 8;
  262.    s := 1;
  263.    while (raster[rl][s] = #0) and (s < n) do
  264.       inc(s);
  265.    if s=n then exit;
  266.  
  267. {  if (skip = 0) then
  268.       skip := s
  269.    else
  270.       s := skip; }
  271. s := 1;
  272.  
  273.    printc(#27'*b'+itoa(n-s+1+(leadpix div 8))+'W');
  274.    sr := @raster[rl][s];
  275.    if n > sizeof(rastline) then
  276.    begin
  277.       writeln('n(',n,') > ',sizeof(rastline));
  278.       halt;
  279.    end;
  280.  
  281.    for i := 1 to leadpix div 8 do
  282.       printc(#0);
  283.  
  284. {$ifndef test}
  285. Inline(
  286.   $8B/$4E/<N/            {   MOV CX,[BP+<N]}
  287.   $2B/$4E/<S/            {   SUB CX,[BP+<S]}
  288.   $41/                   {   INC CX}
  289.   $C4/$7E/<SR/           {   LES DI,[BP+<SR]}
  290.                          {NEXT:}
  291.   $26/                   {   ES:}
  292.   $8A/$05/               {   MOV AL,[DI]}
  293.   $47/                   {   INC DI}
  294.   $30/$E4/               {   XOR AH,AH}
  295.   $31/$D2/               {   XOR DX,DX}
  296.   $51/                   {   PUSH CX}
  297.   $55/                   {   PUSH BP}
  298.   $CD/$17/               {   INT 23}
  299.   $5D/                   {   POP BP}
  300.   $59/                   {   POP CX}
  301.   $E2/$F0);              {   LOOP NEXT}
  302. {$endif}
  303.  
  304. (*******
  305.    for i := s to n do
  306.    begin
  307.       c := sr^;
  308.       inc(srp.o);
  309.       reg.ax := ord(c);
  310.       reg.dx := 0;
  311.       intr(23, reg);
  312.    end;
  313. *******)
  314. end;
  315.  
  316.  
  317. (* -------------------------------------------------------- *)
  318. procedure convert_linefeed;
  319. var
  320.    c:    char;
  321.    n:    integer;
  322. begin
  323.    {determine space value}
  324.    bread(c); n := ord(c);
  325.    bread(c);    {skip the c/r}
  326.  
  327.    if n = 19 then
  328.    begin
  329.       write('.');
  330.       for n := 0 to 6 do
  331.       begin
  332.          outrast(n+1);
  333.          outrast(n+9);
  334.          outrast(n+17);
  335.       end;
  336.  
  337.       rline := 1;
  338.       {imagesz := 0;}
  339.    end
  340.    else
  341.  
  342.    if n > 19 then
  343.    begin
  344.       write('+');
  345.       for n := 0 to 7 do
  346.       begin
  347.          outrast(n+1);
  348.          outrast(n+9);
  349.          outrast(n+17);
  350.       end;
  351.  
  352.       rline := 1;
  353.       {imagesz := 0;}
  354.    end;
  355. end;
  356.  
  357.  
  358. (* -------------------------------------------------------- *)
  359. procedure outlrast;
  360. var
  361.    n:    integer;
  362. begin
  363.    write('.');
  364.    for n := 0 to 7 do
  365.    begin
  366.       outrast(n+1);
  367.       outrast(n+9);
  368.       if rline > 17 then
  369.          outrast(n+17);
  370.    end;
  371.  
  372.    rline := 1;
  373.    {imagesz := 0;}
  374.    fillchar(raster,sizeof(raster),0);
  375. end;
  376.  
  377.  
  378. (* -------------------------------------------------------- *)
  379. procedure convert_vspace;
  380. var
  381.    c:    char;
  382.    n:    integer;
  383. begin
  384.    {determine space value}
  385.    bread(c);
  386.    n := ord(c);
  387.  
  388. {$ifdef test}
  389.    writeln('n=',n,' imagesz=',imagesz);
  390. {$endif}
  391.  
  392.    if (n = 22) and (rline > 1) then
  393.       outlrast;
  394. end;
  395.  
  396. (* -------------------------------------------------------- *)
  397.  
  398. var
  399.    name:    string;
  400.    c:       char;
  401.  
  402. begin
  403.    if paramcount <> 1 then
  404.    begin
  405.       writeln('Usage: EasyDJ FILE');
  406.       halt;
  407.    end;
  408.  
  409.    name := paramstr(1);
  410.    fd := dos_open(name,open_read);
  411.    if fd = dos_error then
  412.    begin
  413.       writeln('Can''t open: ',name);
  414.       halt;
  415.    end;
  416.  
  417.    printc(#27'E');         {reset printer}
  418.    printc(#27'*t150R');    {resolution 300dpi}
  419.    printc(#27'&l66P');     {page length 66 lines}
  420.    printc(#27'&l3A');      {paper 8.5 x 14}
  421.    printc(#27'*rA');       {print from cursor position}
  422.    rline := 1;
  423.    blast := 0;
  424.    bnext := 1;
  425.    imagesz := 0;
  426.  
  427.    repeat
  428.       bread(c);
  429.       if c = #27 then
  430.       begin
  431.          bread(c);
  432. {$ifdef test}
  433.          write('blast=',blast:4,' ');
  434.          write('esc ',c,' ');
  435. {$endif}
  436.          if (c = 'Z') or (c = 'L') then
  437.             convert_bitstream
  438.          else
  439.          if c = 'J' then
  440.             convert_linefeed
  441.          else
  442.          if c = '3' then
  443.             convert_vspace
  444.          else
  445.          if c = '@' then
  446.             outlrast
  447.          else
  448.          begin
  449.           { printc(#27);
  450.             printc(c); }
  451.             writeln(' unknown esc ',ord(c));
  452.          end;
  453.       end
  454.       else
  455.  
  456.       if (c = ' ') or (c = #10) or (c = #13) then
  457.  
  458.       else
  459.          printc(c);
  460.  
  461.    until blast = 0;
  462.  
  463.    printc(#27'*rB');    {end graphics}
  464.    printc(#27'E');      {reset printer}
  465.    writeln;
  466. end.
  467.  
  468.